home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD001b.dsk / KAFMF.bas < prev    next >
BASIC Source File  |  2003-06-12  |  12KB  |  390 lines
  1. 5  REM  KAFMF (KEYED ACCESS FILE MAINT)
  2. 9 TH = 1000:W = 1:Z = 0
  3. 10 D$ =  CHR$(4)
  4. 12  GOTO 7000
  5. 15  ONERR  GOTO 9000
  6. 20  PRINT D$"OPEN "NF$",L"RL
  7. 30  PRINT D$"READ "NF$",R0"
  8. 50  INPUT H1: INPUT L1: INPUT CD$: INPUT BD$: INPUT FT$
  9. 51 H1 = H1 -1000
  10. 52 L1 = L1 -1000
  11. 55  POKE 216,0
  12. 105  PRINT D$
  13. 106  HOME 
  14. 110  PRINT "FILE MAINTENANCE ON ";: INVERSE : PRINT NF$: NORMAL : GOSUB 9400: INVERSE : PRINT NZ$(W);: NORMAL : PRINT " IS ";
  15. 112  IF TZ$(W) = "C" GOTO 116
  16. 114  PRINT "NUMERIC": PRINT "MIN = ";LZ(1);",  MAX = ";VZ(1): GOSUB 9400: GOTO 130
  17. 116  PRINT "CHARACTER, MAX LENGTH ";LZ(1): GOSUB 9400
  18. 130  INVERSE : PRINT NF$;: NORMAL : PRINT " IS A ";
  19. 132  IF FT$ = "S"  THEN  PRINT "SEQUENTIAL";
  20. 134  IF FT$ < >"S"  THEN  PRINT "KEYED";
  21. 136  PRINT " FILE": GOSUB 9400
  22. 138  IF FT$ < >"S" GOTO 150
  23. 139  IF R$ = "S" GOTO 150
  24. 140  PRINT "DO YOU WANT TO PUT A NEW RECORD ON IT";
  25. 142  INPUT R$
  26. 144  IF R$ = "Y" GOTO 170
  27. 146  IF R$ = "N" GOTO 149
  28. 148  GOTO 140
  29. 149  GOSUB 9400: PRINT "THEN YOU MUST WANT TO SEARCH FOR AN": PRINT  TAB( 20);"EXISTING RECORD.": GOSUB 9400
  30. 150  PRINT NZ$(W);
  31. 151  IF TZ$(W) = "C" GOTO 159
  32. 152  INPUT A: IF A < > INT(A) GOTO 795
  33. 153  IF A < = 0 GOTO 790
  34. 154  IF A <LZ(1) GOTO 790
  35. 155  IF A >VZ(1) GOTO 785
  36. 156 A$ =  STR$(A):B$ =  STR$(VZ(1))
  37. 157  IF  LEN(A$) > =  LEN(B$) GOTO 200
  38. 158 A$ = "0" +A$: GOTO 157
  39. 159  INPUT A$: IF A$ < = "0" GOTO 780
  40. 160  IF A$ > = "^" GOTO 780
  41. 161  IF  LEN(A$) >LZ(1) GOTO 775
  42. 162  GOTO 200
  43. 170 AS$ = "Y"
  44. 200  PRINT D$"READ "NF$",R"H1
  45. 201  INPUT B:R = B -TH
  46. 202  PRINT D$"READ "NF$",R"R
  47. 203  INPUT B:B = B -TH: INPUT F:F = F -TH: INPUT A1$: IF AS$ = "Y"  THEN  GOSUB 350
  48. 204  IF A1$ <A$ GOTO 400
  49. 205 UM =  INT((L1 ^.5) -(L1 ^.25)) +W:NR = Z:L = W:LA$ = "0": PRINT D$: HOME : PRINT "*** BE PATIENT ***"
  50. 206  PRINT "FILE HAS ";L1 -2;" RECORDS"
  51. 210 NR = NR +W: IF NR >UM GOTO 280
  52. 220 R = W + INT( RND(W) *(L1 -W))
  53. 230  PRINT D$"READ "NF$",R"R
  54. 240  INPUT B: INPUT F: INPUT A1$
  55. 250  IF B = TH  AND F = TH GOTO 210
  56. 260  IF A1$ >A$ GOTO 210
  57. 270  IF A1$ >LA$ GOTO 272
  58. 271  GOTO 210
  59. 272 L = R:LA$ = A1$: GOTO 210
  60. 280 R = L
  61. 290  PRINT D$"READ "NF$",R"R
  62. 300  INPUT B:B = B -TH: INPUT F:F = F -TH: INPUT A1$
  63. 310  IF A1$ = A$ GOTO 5000
  64. 320  IF A1$ >A$ GOTO 540
  65. 330 R = F:PB = B: GOTO 290
  66. 350 A$ =  STR$( VAL(A1$) +W)
  67. 355  IF  LEN(A$) = 4  THEN  RETURN 
  68. 360 A$ = "0" +A$: GOTO 355
  69. 400 PB = B:B = R:R = H1: PRINT D$: HOME 
  70. 410  IF AS$ = "Y" GOTO 615
  71. 540  PRINT D$: HOME 
  72. 560  PRINT NZ$(W);" ";: INVERSE : PRINT A$;: NORMAL : PRINT " NOT FOUND"
  73. 565  IF FT$ = "S" GOTO 750
  74. 570  PRINT "DO YOU WANT TO ADD IT TO ";NF$;"?";: INPUT R$
  75. 580  IF R$ = "N" GOTO 755
  76. 590  IF R$ = "Y" GOTO 620
  77. 600  PRINT "REPLY Y OR N"
  78. 610  GOTO 540
  79. 615 AS$ = "N"
  80. 620  GOSUB 4000:F = R:R = L1:A1$ = A$: GOTO 5030
  81. 750  GOSUB 9450
  82. 755  IF A1$ < >"^" GOTO 757
  83. 756 R = B
  84. 757  IF R = 1 GOTO 9500
  85. 758  PRINT D$"READ "NF$",R";R
  86. 759  INPUT B:B = B -1000: INPUT F:F = F -1000: INPUT A1$:A$ = A1$
  87. 770  IF R = H1 GOTO 756
  88. 771  GOTO 5000
  89. 775  PRINT "*** MAX LENGTH IS ";LZ(1): GOTO 150
  90. 780  PRINT "*** OUT OF RANGE": GOTO 150
  91. 785  PRINT "*** MAX IS ";VZ(1): GOTO 150
  92. 790  PRINT "*** MIN IS ";LZ(1): GOTO 150
  93. 795  PRINT "*** MUST BE AN INTEGER": GOTO 150
  94. 890  PRINT D$"WRITE "NF$",R"R
  95. 900  PRINT 1000: PRINT 1000
  96. 910 PB = B
  97. 920 R = F
  98. 930  PRINT D$"READ "NF$",R"R
  99. 940  INPUT B: INPUT F
  100. 941 B = B -1000
  101. 942 F = F -1000
  102. 950  PRINT D$"WRITE "NF$",R"R
  103. 960  PRINT PB +1000: PRINT F +1000
  104. 970  PRINT D$"READ "NF$",R"PB
  105. 980  INPUT B: INPUT F
  106. 981 B = B -1000
  107. 982 F = F -1000
  108. 990  PRINT D$"WRITE "NF$",R"PB
  109. 1000  PRINT B +1000: PRINT R +1000
  110. 1010  PRINT D$
  111. 1020  HOME 
  112. 1030  PRINT NZ$(W);" ";A$;" DELETED"
  113. 1035  GOSUB 9450
  114. 1040  GOTO 105
  115. 4000 FZ$(W) = A$
  116. 4010 YN$ = "N":SW = 0
  117. 4020 I = 1: GOTO 4030
  118. 4025 SW = 1
  119. 4030 I = I +1
  120. 4040  IF I >NF GOTO 4440
  121. 4050  IF RZ$(I) = YN$ GOTO 4025
  122. 4060  GOSUB 9400
  123. 4061  PRINT NZ$(I); TAB( 14);
  124. 4070  IF TZ$(I) = "N" GOTO 4330
  125. 4080  INPUT I$
  126. 4090  IF  LEN(I$) >LZ(I) GOTO 4310
  127. 4100  IF  LEN(I$) = 0 GOTO 4270
  128. 4110  IF VZ(I) = 0 GOTO 4260
  129. 4120 J =  INT(VZ(I)/1000)
  130. 4130 K = VZ(I) -(J *1000)
  131. 4140  IF I$ = VZ$(J) GOTO 4260
  132. 4150 J = J +1
  133. 4160  IF J >K GOTO 4180
  134. 4170  GOTO 4140
  135. 4180 J =  INT(VZ(I)/1000)
  136. 4190  GOSUB 9400
  137. 4200  PRINT "*** VALID VALUES ARE ***"
  138. 4210  PRINT  TAB( 15);
  139. 4220  PRINT VZ$(J); TAB( 26);MZ$(J)
  140. 4230 J = J +1: IF J >K GOTO 4060
  141. 4240  GOTO 4210
  142. 4260 FZ$(I) = I$: GOTO 4030
  143. 4270  IF DZ(I) >1000 GOTO 4300
  144. 4280 J = DZ(I)
  145. 4285 FZ$(I) = SZ$(J): GOTO 4030
  146. 4300 J = DZ(I) -1000
  147. 4305 FZ$(I) = DZ$(J): GOTO 4030
  148. 4310  PRINT "*** MAX LENGTH IS ";LZ(I): GOTO 4060
  149. 4330  INPUT J
  150. 4390  IF J <LZ(I) GOTO 4430
  151. 4400  IF J >VZ(I) GOTO 4420
  152. 4410 FZ$(I) =  STR$(J): GOTO 4030
  153. 4420  PRINT "*** MAX IS"; TAB( 15);VZ(I): GOTO 4060
  154. 4430  PRINT "*** MIN IS"; TAB( 15);LZ(I): GOTO 4060
  155. 4440  IF YN$ = "Y" GOTO 4640
  156. 4445  IF SW = 0 GOTO 4640
  157. 4450  GOSUB 9400
  158. 4460  PRINT "*** THAT'S ALL THE REQUIRED DATA ***"
  159. 4470  INPUT "*** WANT THE REST TO DEFAULT?";R$
  160. 4480  IF R$ = "Y" GOTO 4520
  161. 4490  IF R$ = "N" GOTO 4510
  162. 4500  PRINT "*** REPLY Y OR N": GOTO 4470
  163. 4510 YN$ = "Y": GOTO 4020
  164. 4520 I = 1
  165. 4530 I = I +1
  166. 4540  IF I >NF GOTO 4640
  167. 4550  IF RZ$(I) = "Y" GOTO 4530
  168. 4560  IF TZ$(I) = "N" GOTO 4620
  169. 4580 J = DZ(I)
  170. 4590 FZ$(I) = SZ$(J): GOTO 4530
  171. 4600 J = DZ(I) -1000
  172. 4610 FZ$(I) = DZ$(J): GOTO 4530
  173. 4620 J = DZ(I)
  174. 4630 FZ$(I) =  STR$(J): GOTO 4530
  175. 4640 L1 = L1 +1
  176. 4650  PRINT D$"WRITE "NF$",R"L1
  177. 4660  PRINT B +1000: PRINT R +1000: PRINT A$
  178. 4670 I = 1
  179. 4680 I = I +1
  180. 4690  IF I >NF GOTO 4710
  181. 4700  PRINT FZ$(I): GOTO 4680
  182. 4710  PRINT D$"WRITE "NF$",R"R
  183. 4720  PRINT L1 +1000
  184. 4730  PRINT D$"WRITE "NF$",R"B
  185. 4740  PRINT PB +1000: PRINT L1 +1000
  186. 4750  PRINT D$"WRITE "NF$",R0"
  187. 4760  PRINT H1 +1000: PRINT L1 +1000
  188. 4790  RETURN 
  189. 5000 FZ$(W) = A$:I = W
  190. 5010 I = I +1: IF I >NF GOTO 5030
  191. 5020  INPUT FZ$(I): GOTO 5010
  192. 5030  PRINT D$:I = 1: GOTO 5310
  193. 5050 I = I +1:J = J +1: IF I >NF GOTO 5320
  194. 5060  IF J >9 GOTO 5320
  195. 5070  PRINT J;" ";NZ$(I); TAB( 16);
  196. 5080  IF TZ$(I) = "N" GOTO 5100
  197. 5090  IF  LEN(FZ$(I)) >24 GOTO 5180
  198. 5100  INVERSE : PRINT FZ$(I);: NORMAL : IF TZ$(I) = "C" GOTO 5130
  199. 5110  PRINT 
  200. 5120  GOSUB 9400: GOTO 5050
  201. 5130  IF VZ(I) = O GOTO 5110
  202. 5140 X =  INT(VZ(I)/1000):Y = VZ(I) -(X *1000)
  203. 5150  IF FZ$(I) = VZ$(X) GOTO 5170
  204. 5160 X = X +1: IF X >Y GOTO 5110
  205. 5165  GOTO 5150
  206. 5170  PRINT  TAB( 24);: INVERSE : PRINT MZ$(X): NORMAL : GOTO 5120
  207. 5180 Y =  LEN(FZ$(I)) -24:X$ =  LEFT$(FZ$(I),24)
  208. 5190 Y$ =  RIGHT$(FZ$(I),Y): INVERSE : PRINT X$: NORMAL 
  209. 5200  PRINT "---------------------------------";: INVERSE : PRINT Y$: NORMAL 
  210. 5210  GOTO 5050
  211. 5250  IF R$ = "D" GOTO 5900
  212. 5260  IF R$ >"0" GOTO 5300
  213. 5275  GOTO 5670
  214. 5300  IF R$ <":" GOTO 5400
  215. 5305  GOTO 5670
  216. 5310  HOME : PRINT  TAB( 13);W + INT((I -W)/9);" OF "; INT((NF +7)/9);"    ";NF$
  217. 5311 B$ =  LEFT$(FZ$(W),23)
  218. 5312  PRINT "  ";NZ$(W); TAB( 16);: INVERSE : PRINT B$: NORMAL 
  219. 5314 J = 0: GOSUB 9400: GOTO 5050
  220. 5320  IF R1$ = "C" GOTO 5720
  221. 5330  PRINT "  S=SEARCH FOR NEW ";NZ$(W)
  222. 5331  PRINT "1-9=CHANGE DATA      A=ADD Q=QUIT"
  223. 5335  PRINT "  M=MORE N=NXT P=PRV C=CPY D=DEL ";: INPUT R$
  224. 5338  IF R$ = "Q" GOTO 9500
  225. 5340  IF R$ = "M" GOTO 5720
  226. 5350  IF R$ = "N" GOTO 5750
  227. 5360  IF R$ = "P" GOTO 5800
  228. 5370  IF R$ = "S" GOTO 105
  229. 5380  IF R$ = "C" GOTO 5850
  230. 5385  IF R$ = "A" GOTO 5880
  231. 5390  GOTO 5250
  232. 5400 G =  VAL(R$): IF G >J -1 GOTO 5700
  233. 5401  IF G < > INT(G) GOTO 5712
  234. 5403 G = G +1 +(9 * INT((I -3)/9))
  235. 5405  GOSUB 9400
  236. 5410  PRINT "  ";NZ$(G); TAB( 15);
  237. 5420  IF TZ$(G) = "N" GOTO 5620
  238. 5430  INPUT I$
  239. 5440  IF  LEN(I$) >LZ(G) GOTO 5610
  240. 5450  IF VZ(G) = 0 GOTO 5540
  241. 5460 J =  INT(VZ(G)/1000):K = VZ(G) -(J *1000)
  242. 5470  IF I$ = VZ$(J) GOTO 5540
  243. 5480 J = J +1: IF J >K GOTO 5490
  244. 5485  GOTO 5470
  245. 5490 J =  INT(VZ(G)/1000): GOSUB 9400
  246. 5500  PRINT "*** VALID VALUES ARE ***"
  247. 5510  PRINT  TAB( 16);VZ$(J); TAB( 24);MZ$(J)
  248. 5520 J = J +1: IF J >K GOTO 5530
  249. 5525  GOTO 5510
  250. 5530  GOSUB 9400: GOTO 5410
  251. 5540 FZ$(G) = I$
  252. 5560  PRINT D$"WRITE "NF$",R"R
  253. 5570  PRINT B +1000: PRINT F +1000: PRINT A$:Q1 = 1
  254. 5580 Q1 = Q1 +1: IF Q1 >NF GOTO 5600
  255. 5590  PRINT FZ$(Q1): GOTO 5580
  256. 5600  PRINT D$
  257. 5602  IF I <3 GOTO 5030
  258. 5605 I = 1 +(9 * INT((I -3)/9)): GOTO 5310
  259. 5610  PRINT "***MAX LENGTH IS ";LZ(G): GOTO 5530
  260. 5620  INPUT J: IF J <LZ(G) GOTO 5660
  261. 5630  IF J >VZ(G) GOTO 5650
  262. 5640 FZ$(G) =  STR$(J): GOTO 5560
  263. 5650  PRINT "***MAX IS ";VZ(G): GOTO 5530
  264. 5660  PRINT "*** MIN IS ";LZ(G): GOTO 5530
  265. 5670  HOME : PRINT "*** BAD RESPONSE, ENTER AGAIN ***"
  266. 5680  GOSUB 9450: GOTO 5600
  267. 5700  HOME : PRINT "*** MAX CHANGE NBR ON THIS SCREEN IS ";J -1
  268. 5710  GOSUB 9450: GOTO 5600
  269. 5712  HOME : PRINT "*** MUST BE WHOLE NUMBER": GOSUB 9450: GOTO 5600
  270. 5720  IF I < = NF GOTO 5740
  271. 5725  IF R1$ < >"C" GOTO 5030
  272. 5730  PRINT D$"PR#0"
  273. 5735 R1$ = "B": GOTO 5030
  274. 5740 I = I -1: GOTO 5310
  275. 5750  IF F = H1 GOTO 5790
  276. 5760 R = F
  277. 5765  PRINT D$"READ "NF$",R"R
  278. 5770  INPUT B: INPUT F: INPUT A1$:A$ = A1$
  279. 5780 B = B -1000:F = F -1000: GOTO 5000
  280. 5790  HOME : PRINT "*** THAT WAS LAST RECORD ON FILE"
  281. 5795  GOSUB 9450: GOTO 5600
  282. 5800  IF B = 1 GOTO 5830
  283. 5810 R = B: GOTO 5765
  284. 5830  HOME : PRINT "*** THAT WAS FIRST RECORD ON FILE"
  285. 5840  GOSUB 9450: GOTO 5600
  286. 5850  HOME : INPUT "*** TURN ON PRINTER & HIT RETURN";R$
  287. 5860  PRINT D$"PR#1"
  288. 5870 R1$ = "C": PRINT : GOTO 5030
  289. 5880  IF FT$ < >"S" GOTO 105
  290. 5885  GOTO 170
  291. 5900  GOSUB 9400: PRINT "SURE YOU WANT TO DELETE THIS ONE";
  292. 5910  INPUT R$
  293. 5920  IF R$ = "Y" GOTO 890
  294. 5930  GOTO 5600
  295. 7000  ONERR  GOTO 7700
  296. 7010  HOME 
  297. 7012  PRINT "FILE MAINTENANCE": GOSUB 9400
  298. 7020  PRINT "ENTER FILE NAME";
  299. 7030  INPUT NF$
  300. 7040  PRINT D$"OPEN SCMA-"NF$",L60"
  301. 7050  PRINT D$"READ SCMA-"NF$",R0"
  302. 7060  INPUT FP: INPUT FT$: INPUT NF$: INPUT RL: INPUT LR
  303. 7070 FP = FP -100
  304. 7075  INPUT NF: INPUT NV: INPUT ND: INPUT NS
  305. 7076  DIM NZ$(NF),TZ$(NF),RZ$(NF),LZ(NF),VZ(NF),DZ(NF),FZ$(NF)
  306. 7078  DIM MZ$(NV),VZ$(NV),DZ$(ND),SZ$(NS)
  307. 7079 NF = 0:NV = 0:ND = 0:NS = 0
  308. 7080  POKE 216,0
  309. 7090  PRINT D$
  310. 7091  PRINT "LOADING SCMA-";NF$: PRINT 
  311. 7092  PRINT D$"READ SCMA-"NF$",R"FP
  312. 7100  INPUT FP: INPUT TY$:FP = FP -100
  313. 7120  IF TY$ = "N" GOTO 7500
  314. 7130  IF TY$ = "C" GOTO 7190
  315. 7140  IF TY$ = "V" GOTO 7350
  316. 7145  PRINT D$"CLOSE SCMA-"NF$
  317. 7150  GOTO 15
  318. 7190  INPUT VP: INPUT DN$: INPUT RQ$: INPUT ML: INPUT DV$
  319. 7200 NF = NF +1
  320. 7210 NZ$(NF) = DN$
  321. 7220 TZ$(NF) = TY$
  322. 7230 RZ$(NF) = RQ$
  323. 7240 LZ(NF) = ML
  324. 7260  IF  LEN(DV$) <6 GOTO 7300
  325. 7270 ND = ND +1
  326. 7280 DZ$(ND) = DV$
  327. 7285 DZ(NF) = ND +1000
  328. 7290  GOTO 7330
  329. 7300 NS = NS +1
  330. 7310 SZ$(NS) = DV$
  331. 7320 DZ(NF) = NS
  332. 7330  IF VP = 0 GOTO 7090
  333. 7340 CR = FP:FP = VP
  334. 7345 VZ(NF) = (NV +1) *1000
  335. 7348  GOTO 7090
  336. 7350  INPUT MV$: INPUT VV$
  337. 7360 NV = NV +1
  338. 7370 VZ$(NV) = VV$
  339. 7380 MZ$(NV) = MV$
  340. 7400  IF FP < >0 GOTO 7090
  341. 7410 FP = CR
  342. 7420 VZ(NF) = VZ(NF) +NV
  343. 7430  GOTO 7090
  344. 7500  INPUT DN$: INPUT RQ$: INPUT MN: INPUT MX: INPUT DV
  345. 7510 NF = NF +1
  346. 7520 NZ$(NF) = DN$
  347. 7530 TZ$(NF) = TY$
  348. 7540 RZ$(NF) = RQ$
  349. 7550 LZ(NF) = MN
  350. 7560 VZ(NF) = MX
  351. 7570 DZ(NF) = DV
  352. 7580  GOTO 7090
  353. 7700  PRINT D$
  354. 7710  POKE 216,0
  355. 7720  HOME 
  356. 7730  PRINT "SCMA-";NF$;" NOT FOUND"
  357. 7740  PRINT "SCMA-";NF$;" IS REQUIRED"
  358. 7750  PRINT D$"DELETE SCMA-"NF$
  359. 7760  GOTO 9999
  360. 9000  PRINT D$
  361. 9005  POKE 216,0
  362. 9010  HOME 
  363. 9020  INVERSE : PRINT NF$;: NORMAL : PRINT " NOT MOUNTED"
  364. 9030  PRINT "DO YOU WANT TO CREATE A NEW ";: INVERSE : PRINT NF$;: NORMAL : INPUT R$
  365. 9050  IF R$ = "N" GOTO 9090
  366. 9060  IF R$ = "Y" GOTO 9130
  367. 9070  PRINT "REPLY Y OR N"
  368. 9080  GOTO 9010
  369. 9090  HOME 
  370. 9100  PRINT "MOUNT DISKETTE WITH ";NF$;" AND RERUN"
  371. 9110  PRINT D$"DELETE "NF$
  372. 9120  GOTO 9999
  373. 9130 BD$ = "NEVER":CD$ = " "
  374. 9174  PRINT D$"DELETE "NF$
  375. 9176  PRINT D$"OPEN "NF$",L"RL
  376. 9178  PRINT D$"WRITE "NF$",R0"
  377. 9180  PRINT 1002: PRINT 1002: PRINT CD$: PRINT BD$: PRINT FT$
  378. 9190  PRINT D$"WRITE "NF$",R1"
  379. 9200  PRINT 1000: PRINT 1002: PRINT "0"
  380. 9210  PRINT D$"WRITE "NF$",R2"
  381. 9220  PRINT 1001: PRINT 1000: PRINT "^"
  382. 9230  PRINT D$
  383. 9240  GOTO 30
  384. 9400  PRINT "---------------------------------------": RETURN 
  385. 9450 Q3 = 0
  386. 9460 Q3 = Q3 +1: IF Q3 >50 GOTO 9480
  387. 9470  GOTO 9460
  388. 9480  RETURN 
  389. 9500  PRINT D$"CLOSE "NF$
  390. 9999  PRINT D$"RUN JELLO"